home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 7 / BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso / Files / DA / P / PTable.cpt / DeskAcc.Pas < prev    next >
Pascal/Delphi Source File  |  1987-11-17  |  10KB  |  375 lines
  1. PROGRAM DeskAccExample;
  2.  
  3.  
  4. USES MacIntf;
  5.  
  6.  
  7. CONST accEvent    = 64;
  8.       accRun    = 65;
  9.       accCursor    = 66;
  10.       accMenu    = 67;
  11.       accUndo    = 68;
  12.       accCut    = 70;
  13.       accCopy    = 71;
  14.       accPaste    = 72;
  15.       accClear    = 73;
  16.       maxatom   = 105;
  17.       bboxw     = 64;
  18.       bboxh     = 98;
  19.       lboxw     = 17;
  20.       lboxh     = 17;
  21.       startptx  = 10;
  22.       startpty  = 10;
  23.       bboxstx   = 327;
  24.       bboxsty   = 34;
  25.       maxbox = 18;
  26.       maxrow = 9;
  27.       
  28.  
  29. TYPE  tablesize = 0..maxatom;
  30.             BitPtr = ^BitMap;
  31.             BitHandle = ^BitPtr;
  32.             picArray = ARRAY[1..maxatom] OF Rect;
  33.         
  34.         DAGlobals = record
  35.                  lilpic :picArray;
  36.                  tablebits : BitHandle;
  37.          whichelement : tablesize;
  38.                  end;
  39.  
  40.    DAGlobalsP = ^DAGlobals;
  41.    DAGlobalsH = ^DAGlobalsP;
  42.  
  43.  
  44. PROCEDURE FigureRect(Device: DCtlEntry);
  45.   
  46.   TYPE boxrange = 1..maxbox;
  47.        rowrange = 1..maxrow;
  48.        boxes = SET OF boxrange;
  49.        tabletype = ARRAY[1..maxrow] OF boxes;
  50.   VAR index : rowrange;
  51.       table : tabletype;
  52.       tempset : boxes;
  53.       element : tablesize;
  54.       
  55.   PROCEDURE onerow(VAR element : tablesize;
  56.                        row : rowrange;
  57.                   whichones : boxes);
  58.     VAR count : boxrange;
  59.        top,left,bottom,right : integer;
  60.        DAGlobalsHndl : DAGlobalsH;
  61.     BEGIN
  62.      top := startpty+(row-1)*lboxh - (row-1);
  63.      bottom := top + lboxh;
  64.      FOR count := 1 to maxbox DO
  65.       IF count IN whichones THEN
  66.         BEGIN
  67.          left := startptx + (count-1)*lboxw - (count-1);
  68.          right := left + lboxw;
  69.          HLock(Device.DCtlStorage);
  70.          DAGlobalsHndl := DAGlobalsH(Device.DCtlStorage);
  71.          WITH DAGlobalsHndl^^ DO
  72.              SetRect(lilpic[element],left,top,right,bottom);
  73.          HUnlock(Device.DCtlStorage);
  74.          element := element + 1;
  75.         END;
  76.     END;
  77.  
  78.  
  79.   BEGIN 
  80.     element := 1;
  81.     table[1] := [1,18];
  82.     table[2] := [1,2,13,14,15,16,17,18];
  83.     table[3] := table[2];
  84.     table[4] := [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18];
  85.     table[5] := table[4];
  86.     table[6] := [1,2,3];
  87.     FOR index := 1 to 6 DO
  88.       onerow(element,index,table[index]);
  89.     element := 72;
  90.     tempset := [4,5,6,7,8,9,10,11,12,13,14,15,16,17,18];
  91.     onerow(element,6,tempset);
  92.     tempset := [1,2,3];
  93.     element := 87;
  94.     onerow(element,7,tempset);
  95.     tempset := [4,5];
  96.     element := 104;
  97.     onerow(element,7,tempset);
  98.     tempset := [5,6,7,8,9,10,11,12,13,14,15,16,17,18];
  99.     element := 58;
  100.     onerow(element,8,tempset);
  101.     element := 90;
  102.     onerow(element,9,tempset);
  103.   END;
  104.  
  105.   
  106.  
  107. PROCEDURE WhichBox(where: Point;
  108.                    Device : DCtlEntry);
  109.   VAR index : tablesize;
  110.       DAGlobalsHndl : DAGlobalsH;
  111.   BEGIN
  112.      GlobaltoLocal(where);
  113.      HLock(Device.DCtlStorage);
  114.      DAGlobalsHndl := DAGlobalsH(Device.DCtlStorage);
  115.      With DAGlobalsHndl^^ DO 
  116.      BEGIN
  117.        FOR index := 1 to maxatom DO
  118.            IF PtInRect(where, lilpic[index])
  119.                          THEN BEGIN
  120.                                    whichelement := index;
  121.                                 InsetRect(lilpic[whichelement],1,1);
  122.                                 InvertRect(lilpic[whichelement]);
  123.                                 InsetRect(lilpic[whichelement],-1,-1);
  124.                                     EXIT;
  125.                                 END;
  126.           whichelement := 0;
  127.      END;
  128.      HUnlock(Device.DCtlStorage);
  129.   END;
  130.   
  131. PROCEDURE DrawBigpic(Device: DCtlEntry);
  132. VAR bigrect,arect : Rect;
  133.     index, first, ResourceID, hoffset  : integer;
  134.     savergn, bigrgn, theclip : RgnHandle;
  135.     DAGlobalsHndl : DAGlobalsH;
  136.       thepic : picHandle;
  137. BEGIN
  138.    SetRect(bigrect,bboxstx,bboxsty,bboxstx + bboxw,bboxsty + bboxh);
  139.      InsetRect(bigrect,1,1);
  140.      EraseRect(bigrect);
  141.      InsetRect(bigrect,-1,-1);
  142.      FrameRect(bigrect);
  143.    Hlock(Device.DCtlStorage);
  144.    DAGlobalsHndl := DAGlobalsH(Device.DCtlStorage);
  145.    WITH DAGlobalsHndl^^ DO
  146.    FOR index := 0 TO 5 DO
  147.      BEGIN
  148.         first := index*20 + 1;
  149.     IF (whichelement-first < 20) AND (whichelement >= first) THEN
  150.     BEGIN
  151.           ResourceID := $BFE0 + 32*(-Device.DCtlRefNum) + 3;
  152.             thepic := GetPicture(ResourceID + index);
  153.       arect := thepic^^.picFrame; 
  154.             OffsetRect(arect,bboxstx-arect.left - 3,bboxsty-arect.top - 4);
  155.       hoffset := -((whichelement-first)*bboxw - (whichelement-first));
  156.       OffsetRect(arect,hoffset,0);
  157.       savergn := NewRgn;
  158.       bigrgn := NewRgn;
  159.             theclip := NewRgn;
  160.       GetClip(theclip);
  161.             GetClip(savergn);
  162.       RectRgn(bigrgn,bigrect);
  163.       SectRgn(bigrgn,savergn,theclip);
  164.       SetClip(theclip);
  165.       DrawPicture(thepic,arect);
  166.       SetClip(savergn);
  167.             DisposeRgn(savergn);
  168.             DisposeRgn(theclip);
  169.             DisposeRgn(bigrgn);
  170.             ReleaseResource(Handle(thepic));
  171.     END;
  172.     END;
  173.     HUnlock(Device.DCtlStorage);
  174. END;
  175.  
  176. PROCEDURE DrawTable(Device:DCtlEntry);
  177.    VAR 
  178.        ResourceID : integer;
  179.        theWind : WindowPtr;
  180.               srcbits, destbits : BitMap;
  181.               srcrect, destrect : Rect;
  182.               DAGlobalsHndl : DAGlobalsH;
  183.    BEGIN
  184.       theWind := WindowPtr(Device.DCtlWindow);
  185.       SetPort(theWind);
  186.             DAGlobalsHndl := DAGlobalsH(Device.DCtlStorage);
  187.             WITH DAGlobalsHndl^^ DO
  188.                 BEGIN
  189.                     srcrect := tablebits^^.bounds;
  190.                      srcbits := tablebits^^;
  191.                  END;
  192.           destrect := srcrect;
  193.             offsetrect(destrect,startptx-destrect.left-2,startpty-destrect.top-2);
  194.             destbits := theWind^.portBits;
  195.       Copybits(srcbits,destbits,srcrect,destrect,1,NIL);
  196.       DrawBigpic(Device);
  197.    END;
  198.     
  199. PROCEDURE DrawPitch(Device:DCtlEntry);
  200.     VAR pitchdl : PicHandle;
  201.           ResourceID : Integer;
  202.             theWind : WindowPtr;
  203.     BEGIN
  204.       theWind := WindowPtr(Device.DCtlWindow);
  205.          SetPort(theWind);
  206.          ResourceID := $BFE0 + 32*(-Device.DctlRefNum) + 9;
  207.          pitchdl := GetPicture(ResourceID);
  208.          HLock(Handle(pitchdl));
  209.          DrawPicture(pitchdl, pitchdl^^.picFrame);
  210.          FlushEvents(mDownMask,0);
  211.          WHILE NOT Button DO;
  212.          FlushEvents(mDownMask,0);
  213.          EraseRect(pitchdl^^.picFrame);
  214.          HUnlock(Handle(pitchdl));
  215.          ReleaseResource(Handle(pitchdl));
  216.     END;
  217.  
  218. PROCEDURE UpdateDA(var Device: DCtlEntry);
  219. begin
  220.    BeginUpdate(WindowPtr(Device.DCtlWindow));
  221.      DrawTable(Device);
  222.    EndUpdate(WindowPtr(Device.DCtlWindow))
  223. end; { of UpdateDA }
  224.  
  225.  
  226. (* ***** The Open, Ctl, and Close procedures for a Desk Accessory ***** *)
  227.  
  228. PROCEDURE Open(VAR Device: DCtlEntry;
  229.            VAR Block:  ParamBlockRec);
  230.  
  231. VAR   ResourceID: Integer;
  232.             tempint : longint;
  233.       TmpPtr:     Ptr;
  234.       WPeek:      WindowPeek;
  235.       DAGlobalsHndl : DAGlobalsH;
  236.             tempbits : BitHandle;
  237.       
  238. BEGIN
  239.    { Check to see if this is the first time to be Opened. }
  240.    if Device.DctlWindow = nil then begin
  241.    
  242.       { Compute resource ID of this Desk Accessory.  Remember Font/DA Mover can
  243.          change them on you. That's why we use resource numbers which are OWNED
  244.      by a particular DRVR resource for Menus, Windows, etc.}
  245.       ResourceID := $BFE0 + 32 * (-Device.DCtlRefNum);
  246.  
  247.       { Allocate the "global" storage for the Desk Accessory }
  248.       Device.DctlStorage := NewHandle(SIZEOF(DAGlobals));
  249.       
  250.       { Create a hole in the heap.  It is good practice to keep Window records
  251.         off of the bottom of the Application Heap. }
  252.       TmpPtr := NewPtr($1000);
  253.       
  254.       Device.DctlWindow := Pointer(GetNewWindow(ResourceID,nil,Pointer(-1)));
  255.       WPeek := WindowPeek(Device.DCtlWindow);
  256.       WPeek^.WindowKind := Device.DCtlRefNum;
  257.       
  258.       { Make it the current port to make appropriate calls define the port }
  259.       SetPort(GrafPtr(Device.DCtlWindow));
  260.       SetOrigin(0,0);
  261.       FlushEvents(EveryEvent,0);
  262.       
  263.       { add calls for textsize, font, etc. }
  264.  
  265.  
  266.       { Deallocate our temporary pointer }
  267.       DisposPtr(TmpPtr);
  268.       
  269.       { Perform other activities associated with opening the Desk Accessory }
  270.         
  271.             ResourceID := $BFE0 + 32*(-Device.DCtlRefNum) + 1;
  272.           tempbits := BitHandle(GetResource('BITS',ResourceID));
  273.           tempbits^^.baseAddr := @tempbits^^.bounds;
  274.             tempint := Longint(tempbits^^.baseAddr);
  275.             tempint := tempint + 8;
  276.             tempbits^^.baseAddr := Pointer(tempint);
  277.       HLock(Device.Dctlstorage);
  278.       DAGlobalsHndl := DAGlobalsH(Device.DctlStorage);
  279.       With DAGlobalsHndl^^ do 
  280.          begin
  281.            whichelement := 0;
  282.                    tablebits := tempbits;
  283.              end;
  284.       HUnlock(Device.DctlStorage);
  285.       FigureRect(Device);
  286.           DrawPitch(Device);
  287.       DrawTable(Device);
  288.       end;
  289.       
  290. END; (* of Open *)
  291.  
  292. PROCEDURE Ctl(VAR Device: DCtlEntry;
  293.           VAR Block:  ParamBlockRec);
  294.  
  295. (* The Ctl procedure is the main entry point for System Calls.
  296.    The ParamBlckRec parameter tells us what is going on.  Use the infromation
  297.    in here to decide on an action to take.
  298. *)
  299. VAR   Trick: Record
  300.         case integer of
  301.            0: (CSParam: array[0..1] of Integer);
  302.            1: (EventPtr: ^EventRecord)
  303.         end;
  304.      DAGlobalsHndl : DAGLobalsH;
  305. BEGIN
  306.    { Set the current grafport to ours }
  307.    SetPort(GrafPtr(Device.DCtlWindow));
  308.    
  309.    { Assuming the DA's "globals" are going to be used, lets lock them down. }
  310.    HLock(Device.DCtlStorage);
  311.    DAGlobalsHndl := DAGlobalsH(Device.DCtlStorage);
  312.    WITH DAGlobalsHndl^^ DO
  313.    { Find out what happened. }
  314.    case Block.csCode of
  315.       accEvent:  begin
  316.             Trick.CSParam[0] := Block.CSParam[0];
  317.             Trick.CSParam[1] := Block.CSParam[1];
  318.             case Trick.EventPtr^.what of
  319.                   mouseDown:BEGIN
  320.                             WhichBox(Trick.eventPtr^.where,Device);
  321.                             WHILE StillDown DO;
  322.                             FlushEvents(MUpMask,0);
  323.                             IF whichelement <> 0 THEN 
  324.                                BEGIN
  325.                                      InsetRect(lilpic[whichelement],1,1);
  326.                                               InvertRect(lilpic[whichelement]);
  327.                                               InsetRect(lilpic[whichelement],-1,-1);
  328.                                           END;
  329.                             DrawBigpic(Device);
  330.                         END;
  331.                keyDown:     ;
  332.                keyUp:       ;
  333.                updateEvt:   UpdateDA(Device);
  334.                activateEvt: ;
  335.             end;
  336.     end;
  337.         
  338.       accRun:   ;
  339.       accCursor: ;
  340.       accMenu:   ;
  341.       accUndo:   ;
  342.       accCut:    ;
  343.       accCopy:   ;
  344.       accPaste:  ;
  345.       accClear:  ;
  346.    end;
  347.  
  348.    HUnLock(Device.DCtlStorage);
  349. END; (* of Ctl *)
  350.  
  351.  
  352. PROCEDURE Close(VAR Device: DCtlEntry;
  353.         VAR Block:  ParamBlockRec);
  354.  
  355. (* Well this is it!  The Desk Manager has called you to tell you this is the
  356.    end.  You are not allowed to do anything but to remove your windows,
  357.    menu, etc. and reclaim any storage.
  358. *)
  359.  
  360. BEGIN
  361.    with Device do
  362.     begin
  363.       DisposeWindow(WindowPtr(Device.DCtlWindow));
  364.       dctlWindow := nil;
  365.       (* Reclaim the private storage area that we allocated for ourselves. *)
  366.       disposHandle(Handle(DCtlStorage));
  367.     end;
  368. END; (* of Close *)
  369.  
  370.  
  371. BEGIN
  372.    (* No main program allowed *)
  373. END.
  374.  
  375.